home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Parse.cls < prev    next >
Text File  |  1997-06-14  |  4KB  |  165 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "GParse"
  6. Attribute VB_GlobalNameSpace = True
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorParse
  13.     eeBaseParse = 13550
  14. End Enum
  15.  
  16. Function GetQToken(sTarget As String, sSeps As String) As String
  17.     ' Assume failure
  18.     GetQToken = sEmpty
  19.  
  20.     ' Note that sSave and iStart must be static from call to call
  21.     ' If first call, make copy of string
  22.     Static sSave As String, iStart As Integer, cSave As Integer
  23.     Dim iNew As Integer, fQuote As Integer
  24.     If (sTarget <> sEmpty) Then
  25.         iStart = 1
  26.         sSave = sTarget
  27.         cSave = Len(sSave)
  28.     Else
  29.         If sSave = sEmpty Then Exit Function
  30.     End If
  31.     ' Make sure separators includes quote
  32.     sSeps = sSeps & sQuote2
  33.  
  34.     ' Find start of next token
  35.     iNew = StrSpan(sSave, iStart, sSeps)
  36.     If iNew Then
  37.         ' Set position to start of token
  38.         iStart = iNew
  39.     Else
  40.         ' If no new token, return empty string
  41.         sSave = sEmpty
  42.         Exit Function
  43.     End If
  44.     
  45.     ' Find end of token
  46.     If (iStart = 1) Then
  47.         iNew = StrBreak(sSave, iStart, sSeps)
  48.     ElseIf Mid$(sSave, iStart - 1, 1) = sQuote2 Then
  49.         iNew = StrBreak(sSave, iStart, sQuote2)
  50.     Else
  51.         iNew = StrBreak(sSave, iStart, sSeps)
  52.     End If
  53.  
  54.     If iNew = 0 Then
  55.         ' If no end of token, set to end of string
  56.         iNew = cSave + 1
  57.     End If
  58.     ' Cut token out of sTarget string
  59.     GetQToken = Mid$(sSave, iStart, iNew - iStart)
  60.     
  61.     ' Set new starting position
  62.     iStart = iNew
  63.  
  64. End Function
  65.  
  66. Function GetToken(sTarget As String, sSeps As String) As String
  67.     
  68.     ' Assume failure
  69.     GetToken = sEmpty
  70.     
  71.     ' Note that sSave and iStart must be static from call to call
  72.     ' If first call, make copy of string
  73.     Static sSave As String, iStart As Integer, cSave As Integer
  74.     
  75.     If sTarget <> sEmpty Then
  76.         iStart = 1
  77.         sSave = sTarget
  78.         cSave = Len(sSave)
  79.     Else
  80.         If sSave = sEmpty Then Exit Function
  81.     End If
  82.     
  83.     ' Find start of next token
  84.     Dim iNew As Integer
  85.     iNew = StrSpan(sSave, iStart, sSeps)
  86.     If iNew Then
  87.         ' Set position to start of token
  88.         iStart = iNew
  89.     Else
  90.         ' If no new token, return empty string
  91.         sSave = sEmpty
  92.         Exit Function
  93.     End If
  94.     
  95.     ' Find end of token
  96.     iNew = StrBreak(sSave, iStart, sSeps)
  97.     If iNew = 0 Then
  98.         ' If no end of token, set to end of string
  99.         iNew = cSave + 1
  100.     End If
  101.     
  102.     ' Cut token out of sTarget string
  103.     GetToken = Mid$(sSave, iStart, iNew - iStart)
  104.     ' Set new starting position
  105.     iStart = iNew
  106.  
  107. End Function
  108.  
  109. Function StrBreak(sTarget As String, ByVal iStart As Integer, sSeps As String) As Integer
  110.     
  111.     Dim cTarget As Integer
  112.     cTarget = Len(sTarget)
  113.    
  114.     ' Look for end of token (first character that is a separator)
  115.     Do While InStr(sSeps, Mid$(sTarget, iStart, 1)) = 0
  116.         If iStart > cTarget Then
  117.             StrBreak = 0
  118.             Exit Function
  119.         Else
  120.             iStart = iStart + 1
  121.         End If
  122.     Loop
  123.     StrBreak = iStart
  124.  
  125. End Function
  126.  
  127. Function StrSpan(sTarget As String, ByVal iStart As Integer, sSeps As String) As Integer
  128.     
  129.     Dim cTarget As Integer
  130.     cTarget = Len(sTarget)
  131.     ' Look for start of token (character that isn't a separator)
  132.     Do While InStr(sSeps, Mid$(sTarget, iStart, 1))
  133.         If iStart > cTarget Then
  134.             StrSpan = 0
  135.             Exit Function
  136.         Else
  137.             iStart = iStart + 1
  138.         End If
  139.     Loop
  140.     StrSpan = iStart
  141.  
  142. End Function
  143. '
  144.  
  145. #If fComponent = 0 Then
  146. Private Sub ErrRaise(e As Long)
  147.     Dim sText As String, sSource As String
  148.     If e > 1000 Then
  149.         sSource = App.ExeName & ".Parse"
  150.         Select Case e
  151.         Case eeBaseParse
  152.             BugAssert True
  153.        ' Case ee...
  154.        '     Add additional errors
  155.         End Select
  156.         Err.Raise COMError(e), sSource, sText
  157.     Else
  158.         ' Raise standard Visual Basic error
  159.         sSource = App.ExeName & ".VBError"
  160.         Err.Raise e, sSource
  161.     End If
  162. End Sub
  163. #End If
  164.  
  165.